home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #145 (1991-10)(Rhein-Sieg-Soft).zip / Franz PD Disk #145 (1991-10)(Rhein-Sieg-Soft).adf / HochTief / HT.List < prev    next >
Text File  |  1991-10-07  |  17KB  |  642 lines
  1. '************************
  2. '*      HochTief        *
  3. '*                      *
  4. '*     written by       *
  5. '*    Andreas Lesch     *
  6. '*     Okerstr.30A      *
  7. '*  5090 Leverkusen 1   *
  8. '************************
  9.   
  10. WINDOW CLOSE 1
  11. ' *********** T I T E L ***********
  12. ON BREAK GOSUB ende
  13. BREAK ON
  14.  
  15. DECLARE FUNCTION Move& LIBRARY
  16. DECLARE FUNCTION OpenDiskFont& LIBRARY
  17.  
  18. main:
  19.  
  20. SCREEN 1,640,256,3,2
  21. WINDOW 2,"",,0,1
  22. MENU 1,0,0,""
  23. FOR x=0 TO 7
  24.   i=i+10
  25.   y=y+.125
  26.   PALETTE x,y,0,0
  27.   LINE (0+i,0+i)-(WINDOW(2)-i,WINDOW(3)-i),x,bf
  28. NEXT x 
  29.                                 
  30. ON ERROR GOTO fehler
  31. fehler=0
  32. LIBRARY "diskfont.library"                  
  33. fehler=1
  34. LIBRARY "graphics.library"
  35. fehler=2
  36. LIBRARY "intuition.library"
  37. fehler=3
  38.  
  39. i=13
  40.                                 
  41. COLOR 0,3
  42. diskfont "sapphire",19
  43.  
  44. LOCATE 14,21 
  45. shadow2 "      HochTief",31
  46. LOCATE 17,23 
  47. shadow2 "          by <StarSoft ©>",18
  48. LOCATE 20,23
  49. shadow2 "          Linke Maustaste",18
  50. CALL SetFont&(WINDOW(8),altfont&)
  51. i=0:j=0
  52. fl:
  53. IF j=0 THEN i=i+.001
  54. IF j=1 THEN i=i-.001
  55.  
  56. IF i>.8 THEN j=1
  57. IF i<.2 THEN j=0
  58. PALETTE 0,i,0,0
  59. IF  MOUSE(0)=0 THEN fl
  60. WINDOW CLOSE 2
  61.      
  62. WINDOW 2,,(0,10)-(631,240),0,1
  63.  
  64. FOR farbe=0 TO 6
  65.   PALETTE farbe,0,0,0
  66. NEXT farbe
  67.             
  68.  
  69.                      
  70.  
  71. '********** Variablen *************
  72. Variablen:
  73. altfont&=PEEKL(WINDOW(8)+52)
  74. scr&=PEEKL(WINDOW(7)+46)
  75. setzen&=5 : betrag&=100 :index=0 :h=1 :ind=1 :zaehler=1
  76.  
  77.  
  78. RANDOMIZE TIMER
  79.  
  80. '********** Farben ****************
  81.  
  82. DATA .8,.8,.8, 0,0,0, .8,0,0, 0,0,.4, .3,.5,.9, 1,.2,.3
  83.  
  84. '********** Grafiken Datenfelder **
  85.   DIM SHARED KaroKlein%(30),PikKlein%(30),HerzKlein%(30),KreuzKlein%(30)
  86.   DIM SHARED KaroGross%(93),PikGross%(93),HerzGross%(93),KreuzGross%(93) 
  87.   COLOR 4,2:CLS
  88.   COLOR 7,2
  89.   LOCATE 13,23 : PRINT "HochTief  von  Andreas Lesch <StarSoft ©>"
  90.   LOCATE 16,24 : PRINT  "Geben Sie Ihren Namen ein (7 Stellen):"
  91.   LOCATE 18,34 : LINE INPUT nam1$
  92.   COLOR 4,2        
  93.   AREA (51,48):AREA (47,51):AREA (51,54):AREA (55,51):AREAFILL     'Karo
  94.   AREA (90,70):AREA (82,75):AREA (90,80):AREA (98,75):AREAFILL  
  95.   GET (46,48)-(56,54),KaroKlein%
  96.   GET (81,70)-(99,80),KaroGross%  
  97.   CIRCLE (10,5),2:CIRCLE (14,5),2:PAINT (10,5):PAINT (14,5)
  98.   AREA (8,6):AREA (12,9):AREA (16,6):AREAFILL
  99.   CIRCLE (28,10),4:CIRCLE (36,10),4:PAINT (28,10):PAINT (36,10)     'Herz
  100.   AREA (24,11):AREA (32,16):AREA (40,11):AREAFILL
  101.   GET (7,3)-(17,9),HerzKlein%
  102.   GET (22,6)-(40,16),HerzGross%
  103.   COLOR 3,2
  104.   CIRCLE (50,15),2:CIRCLE (54,15),2:PAINT (50,15):PAINT (54,15)      'Pik
  105.   AREA (48,14):AREA (52,11):AREA (56,14):AREAFILL
  106.   LINE (52,16)-(52,17)
  107.   CIRCLE (68,10),4:CIRCLE (76,10),4:PAINT (68,10):PAINT (76,10)     'Pik
  108.   AREA (64,9):AREA (72,5):AREA (79,8):AREAFILL 
  109.   AREA (72,12):AREA (70,14):AREA (74,14):AREAFILL   
  110.   GET (47,11)-(57,17),PikKlein% 
  111.   GET (63,5)-(81,14),PikGross% 
  112.   CIRCLE (100,15),2:CIRCLE (106,15),2:CIRCLE (103,13),2
  113.   PAINT (100,15):PAINT (106,15):PAINT (103,13):LINE (103,16)-(103,17) 'Kreuz
  114.   CIRCLE (200,30),3:CIRCLE(208,30),3:CIRCLE (204,27),3
  115.   PAINT (200,30):PAINT(208,30):PAINT (204,27):LINE (204,28)-(204,30)
  116.   AREA (204,30):AREA (202,33):AREA (206,33):AREAFILL
  117.   GET (98,11)-(108,17),KreuzKlein% 
  118.   GET (195,24)-(213,33),KreuzGross%
  119.   PALETTE 7,0,0,0
  120. COLOR 1,0:CLS
  121.  
  122. '********** Programmsteuerung *****
  123. ON MOUSE GOSUB mauskontrolle
  124.  
  125. '********** HAUPTSCHLEIFE **********
  126. GOSUB hiscoreLesen:
  127. GOSUB titel
  128.  
  129. HauptSchleife:
  130.   MOUSE ON                                 
  131.   taste$=INKEY$
  132.   IF taste$=CHR$(27) THEN
  133.     ende:
  134.     IF HiJa =1 THEN GOSUB HiscoreSchreiben
  135.     MENU RESET
  136.     LIBRARY CLOSE
  137.     END
  138.   END IF
  139. GOTO HauptSchleife
  140.  
  141. '********** Unterprogramme ********
  142. titel:
  143.   diskfont "sapphire",19
  144.   LINE (224,2)-(387,21),3,bf
  145.   LOCATE 1,13
  146.   COLOR 3,4
  147.   PRINT  "   HochTief   "
  148.   CALL SetFont&(WINDOW(8),altfont&)
  149.   LINE (165,25)-(451,33),3,bf
  150.   GOSUB HS
  151.   GOSUB KartenHinten
  152.   GOSUB taste 
  153.   CIRCLE (168,196),70,3:PAINT (168,192),3
  154.   CIRCLE (172,194),70,4:PAINT (172,192),4 
  155.   CIRCLE (464,196),70,3:PAINT (464,192),3
  156.   CIRCLE (468,194),70,4:PAINT (468,192),4 
  157.   GOSUB Gesetzt
  158.   GOSUB Haben
  159.   PALETTE 0,0,.5,0 : PALETTE 1,0,.5,0 
  160.   FOR FarbNr=2 TO 7
  161.     READ r,g,b
  162.     PALETTE FarbNr,r,g,b
  163.   NEXT FarbNr  
  164. RETURN
  165. HS:
  166.   LOCATE 4,22
  167.   COLOR 5,4
  168.   PRINT  "H i g h s c o r e : ";
  169.   PRINT USING "\     \";nam$,
  170.   PRINT USING "#######";score&;
  171.   PRINT " $"
  172. RETURN
  173.  
  174. mauskontrolle:     
  175.   dummy=MOUSE(0) : x=MOUSE(1) : y=MOUSE(2)
  176.   IF y>124 AND y<146  THEN
  177.     IF x>49 AND x<151 AND ja=0 THEN
  178.       LINE (50,125)-(150,145),3,bf
  179.       GOSUB Warte
  180.       GOSUB taste
  181.       IF x<99 THEN
  182.         setzen&=setzen&+1
  183.         IF setzen&>20 THEN setzen&=20
  184.         GOSUB Gesetzt
  185.       END IF 
  186.       IF x>100 THEN
  187.         setzen&=setzen&-1
  188.         GOSUB Gesetzt
  189.       END IF         
  190.     END IF  'Setzen
  191.     
  192.     IF x>189 AND x<291 AND ja=0 THEN
  193.       ja=1 : posi%=0 :j=0
  194.       LINE (190,125)-(290,145),3,bf
  195.       IF setzen&>betrag& THEN
  196.         setzen&=betrag&
  197.         GOSUB Gesetzt
  198.       END IF  
  199.       GOSUB Warte
  200.       GOSUB taste
  201.       GOSUB KartenHinten
  202.       GOSUB ZufallsZahl
  203.       altsetzen&=setzen&   
  204.     END IF   'Spiel
  205.                                      
  206.     IF x>329 AND x<431 AND j=0 THEN
  207.       LINE (330,125)-(430,145),3,bf
  208.       GOSUB Warte
  209.       GOSUB taste
  210.       posi%=posi%+110
  211.       GOSUB ZufallsZahl
  212.       IF zahl(index)<zahl(index-1) THEN GOSUB verloren ELSE setzen&=setzen&+setzen&     
  213.       GOSUB Gesetzt
  214.       GOSUB Haben
  215.       IF index=5 THEN GOSUB gewonnen
  216.     END IF
  217.     
  218.     IF x>469 AND x<571 AND j=0 THEN
  219.       LINE (470,125)-(570,145),3,bf
  220.       GOSUB Warte
  221.       GOSUB taste
  222.       posi%=posi%+110                
  223.       GOSUB ZufallsZahl
  224.       zahl(0)=zahl(index)
  225.       IF zahl(index)>zahl(index-1) THEN GOSUB verloren ELSE setzen&=setzen&+setzen&      
  226.       GOSUB Gesetzt
  227.       GOSUB Haben      
  228.       IF index=5 THEN GOSUB gewonnen
  229.     END IF    
  230.   END IF
  231.   IF index>2 THEN
  232.     LINE (255,162)-(375,192),3,bf
  233.     LINE (257,160)-(377,190),5,bf
  234.     LINE (266,165)-(368,185),4,bf
  235.     LOCATE 22,36 : PRINT CHR$(252)"bernehmen"
  236.   END IF
  237.   IF x>265 AND x<369 AND y>164 AND y<186 AND ja=1 AND index>2 THEN  GOSUB gewonnen 
  238. RETURN
  239.  
  240. verloren:
  241.   FOR klang=500 TO 100 STEP -50
  242.     SOUND klang,1
  243.   NEXT klang  
  244.   betrag&=betrag&-setzen&
  245.   GOSUB Haben
  246.   GOSUB Gesetzt
  247.   GOSUB Ueberweg
  248.   GOSUB var
  249.   GOSUB Gesetzt
  250.   IF betrag&<1 THEN 
  251.     betrag&=100
  252.     setzen&=5
  253.     FOR klang=1000 TO 2000 STEP 100
  254.       SOUND klang,1,INT(klang/10)
  255.     NEXT klang
  256.     CALL tilt
  257.     GOSUB Haben
  258.     GOSUB Gesetzt
  259.     FOR klang=2000 TO 1000 STEP -100
  260.       SOUND klang,1,INT(klang/10)
  261.     NEXT klang     
  262.   END IF  
  263. RETURN HauptSchleife 
  264. gewonnen:
  265.   FOR klang=100 TO 500 STEP 50
  266.     SOUND klang,1
  267.   NEXT klang    
  268.   betrag&=betrag&+setzen&
  269.   GOSUB Haben
  270.   GOSUB Gesetzt
  271.   GOSUB var
  272.   GOSUB Ueberweg
  273.   GOSUB Gesetzt
  274.   IF betrag&>score& THEN
  275.     HiJa=1
  276.     nam$=nam1$:score&=betrag&
  277.     GOSUB HS
  278.   END IF  
  279.   IF betrag&>999999& THEN 
  280.     betrag&=100
  281.     setzen&=5
  282.     FOR klang=1000 TO 5000 STEP 500
  283.       SOUND klang,1
  284.     NEXT klang 
  285.     FOR klang=5000 TO 1000 STEP -500
  286.       SOUND klang,1
  287.     NEXT klang       
  288.     GOSUB Haben
  289.     GOSUB Gesetzt
  290.   END IF    
  291. RETURN HauptSchleife 
  292. Ueberweg:
  293.   LINE (255,160)-(377,192),0,bf
  294. RETURN
  295.      
  296. var:
  297.   posi%=0:index=0:ja=0:j=1:fehler=0:h(i)=0:ind=1:i=0:setzen&=altsetzen&
  298. RETURN     
  299. taste:
  300. xs=0
  301.   FOR i=1 TO 4
  302.     LINE (xs+37,122)-(xs+157,152),3,bf
  303.     LINE (xs+40,120)-(xs+160,150),5,bf
  304.     LINE (xs+50,125)-(xs+150,145),7,bf
  305.     xs=xs+140
  306.   NEXT i 
  307.   COLOR 5,7
  308.   LOCATE 17,8 : PRINT "+ Setzen -" 
  309.   LOCATE 17,28: PRINT "Spiel"
  310.   LOCATE 17,46: PRINT "h"CHR$(246)"her"
  311.   LOCATE 17,63: PRINT "tiefer"
  312. RETURN
  313. Warte:
  314.   FOR i=1 TO 100 : NEXT
  315. RETURN      
  316.  
  317. KartenHinten:
  318.   FOR karten%=40 TO 480 STEP 110
  319.     CALL karte (karten%,6)                   
  320.   NEXT karten%    
  321. RETURN
  322.  
  323. ZufallsZahl:
  324.   index=index+1
  325.   zaehler=zaehler+1
  326.   neu:
  327.   zahl(index)=INT(1+((32)*RND))
  328.   help=zahl(index)
  329.   h(i)=index
  330.   FOR i=1 TO 6
  331.   IF zahl(i)=help AND h(i) <> index THEN GOTO neu
  332.   NEXT i
  333.  
  334.   IF posi%>440 THEN posi%=0 
  335.   IF zahl(index)= 1 THEN CALL Sieben(posi%,KaroKlein%(),KaroGross%(),4)
  336.   IF zahl(index)= 2 THEN CALL Sieben(posi%,HerzKlein%(),HerzGross%(),4)
  337.   IF zahl(index)= 3 THEN CALL Sieben(posi%,PikKlein%(),PikGross%(),3)
  338.   IF zahl(index)= 4 THEN CALL Sieben(posi%,KreuzKlein%(),KreuzGross%(),3)
  339.   IF zahl(index)= 5 THEN CALL Acht(posi%,KaroKlein%(),KaroGross%(),4)
  340.   IF zahl(index)= 6 THEN CALL Acht(posi%,HerzKlein%(),HerzGross%(),4)
  341.   IF zahl(index)= 7 THEN CALL Acht(posi%,PikKlein%(),PikGross%(),3)
  342.   IF zahl(index)= 8 THEN CALL Acht(posi%,KreuzKlein%(),KreuzGross%(),3)
  343.   IF zahl(index)= 9 THEN CALL Neun(posi%,KaroKlein%(),KaroGross%(),4)
  344.   IF zahl(index)=10 THEN CALL Neun(posi%,HerzKlein%(),HerzGross%(),4)
  345.   IF zahl(index)=11 THEN CALL Neun(posi%,PikKlein%(),PikGross%(),3)
  346.   IF zahl(index)=12 THEN CALL Neun(posi%,KreuzKlein%(),KreuzGross%(),3)
  347.   IF zahl(index)=13 THEN CALL Zehn(posi%,KaroKlein%(),KaroGross%(),4)
  348.   IF zahl(index)=14 THEN CALL Zehn(posi%,HerzKlein%(),HerzGross%(),4)
  349.   IF zahl(index)=15 THEN CALL Zehn(posi%,PikKlein%(),PikGross%(),3)
  350.   IF zahl(index)=16 THEN CALL Zehn(posi%,KreuzKlein%(),KreuzGross%(),3)
  351.   IF zahl(index)=17 THEN CALL Bube(posi%,KaroKlein%(),KaroGross%(),4)
  352.   IF zahl(index)=18 THEN CALL Bube(posi%,HerzKlein%(),HerzGross%(),4)
  353.   IF zahl(index)=19 THEN CALL Bube(posi%,PikKlein%(),PikGross%(),3)
  354.   IF zahl(index)=20 THEN CALL Bube(posi%,KreuzKlein%(),KreuzGross%(),3)
  355.   IF zahl(index)=21 THEN CALL Dame(posi%,KaroKlein%(),KaroGross%(),4)
  356.   IF zahl(index)=22 THEN CALL Dame(posi%,HerzKlein%(),HerzGross%(),4)
  357.   IF zahl(index)=23 THEN CALL Dame(posi%,PikKlein%(),PikGross%(),3)
  358.   IF zahl(index)=24 THEN CALL Dame(posi%,KreuzKlein%(),KreuzGross%(),3)
  359.   IF zahl(index)=25 THEN CALL Koenig(posi%,KaroKlein%(),KaroGross%(),4)
  360.   IF zahl(index)=26 THEN CALL Koenig(posi%,HerzKlein%(),HerzGross%(),4)
  361.   IF zahl(index)=27 THEN CALL Koenig(posi%,PikKlein%(),PikGross%(),3)
  362.   IF zahl(index)=28 THEN CALL Koenig(posi%,KreuzKlein%(),KreuzGross%(),3)
  363.   IF zahl(index)=29 THEN CALL Asi(posi%,KaroKlein%(),KaroGross%(),4)
  364.   IF zahl(index)=30 THEN CALL Asi(posi%,HerzKlein%(),HerzGross%(),4)
  365.   IF zahl(index)=31 THEN CALL Asi(posi%,PikKlein%(),PikGross%(),3)
  366.   IF zahl(index)=32 THEN CALL Asi(posi%,KreuzKlein%(),KreuzGross%(),3)
  367.  
  368. RETURN
  369.  
  370. Gesetzt:
  371.   COLOR 5,4
  372.   IF setzen&<1 THEN setzen&=1
  373.   IF setzen&>betrag& THEN setzen&=betrag&
  374.   LOCATE 25,14 :PRINT  "Gesetzt:";
  375.   PRINT USING"#####";setzen&;
  376.   PRINT " $"
  377. RETURN
  378.   
  379. Haben:
  380.   COLOR 5,4
  381.   LOCATE 25,51 :PRINT "Guthaben:";        
  382.   PRINT USING"######";betrag&;                     
  383.   PRINT " $" 
  384. RETURN 
  385.  
  386. hiscoreLesen:
  387.   OPEN "Hiscore_HochTief" FOR INPUT AS 1
  388.     INPUT #1,score&
  389.     INPUT #1,nam$
  390.   CLOSE 1  
  391. RETURN                                        
  392.  
  393. HiscoreSchreiben:
  394.   OPEN "Hiscore_HochTief" FOR OUTPUT AS 1
  395.     PRINT #1,score&
  396.     PRINT #1,nam$
  397.   CLOSE 1  
  398. RETURN
  399.  
  400. fehler:
  401.   IF ERR=53 THEN
  402.     IF fehler=0 THEN
  403.       errtext$="Diskfont.bmap"
  404.       GOTO Fehlermeldung
  405.     END IF  
  406.     IF fehler=1 THEN
  407.       errtext$="graphics.bmap"
  408.       GOTO Fehlermeldung
  409.     END IF  
  410.     IF fehler=2 THEN
  411.       errtext$="intuition.bmap"
  412.       GOTO Fehlermeldung
  413.     END IF  
  414.     IF fehler=3 THEN  
  415.       nam$="Andreas":score&=6125&
  416.       GOSUB HiscoreSchreiben
  417.       WINDOW 2
  418.     END IF  
  419.   END IF
  420. RESUME
  421.  
  422. Fehlermeldung:
  423.   WINDOW 3,"Error",(100,50)-(540,100),0,1
  424.   PALETTE 2,1,1,1:PALETTE 0,0,0,0:PALETTE 1,.5,.5,.5
  425.   COLOR 2,0:CLS
  426.   LOCATE 2,1
  427.   PRINT "Keine "errtext$" vorhanden"
  428.   PRINT "Programm wird beendet"
  429.   PRINT "Taste DrÜcken"
  430.   SLEEP:SLEEP:SLEEP
  431.   GOTO ende
  432.      
  433. SUB karte (position%,fa%) STATIC
  434.   LINE (position%-6,43)-(position%+95,114),3,bf
  435.   LINE (position%,39)-(position%+100,111),fa%,bf
  436. END SUB
  437.  
  438. SUB schreiben (po%,Text$,fa%) STATIC
  439.   CALL SetDrMd&(WINDOW(8),0)  'JAM1
  440.   COLOR fa%,2
  441.   lo=INT(po%/8)
  442.   IF (po%=0 OR po%=440) AND Text$="10" THEN lo=lo-1 
  443.   LOCATE 6,7+lo : PRINT Text$ : LOCATE 14,7+lo :PRINT Text$
  444.   LOCATE 6,17+lo : PRINT Text$ : LOCATE 14,17+lo :PRINT Text$
  445.   CALL SetDrMd&(WINDOW(8),1)  'JAM2 (normal)  
  446. END SUB
  447.   
  448. SUB Asi (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC  
  449.   CALL karte (po%+40,2)
  450.   PUT (47+po%,49),FeldNamKl%,PSET
  451.   PUT (126+po%,49),FeldNamKl%,PSET 
  452.   PUT (47+po%,95),FeldNamKl%,PSET        
  453.   PUT (126+po%,95),FeldNamKl%,PSET
  454.   PUT (82+po%,70),FeldnamGr%,PSET 
  455.   CALL schreiben (po%,"A",farb%)
  456. END SUB
  457.   
  458. SUB Koenig (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC  
  459.   CALL karte (po%+40,2) 
  460.   PUT (47+po%,49),FeldNamKl%,PSET
  461.   PUT (126+po%,49),FeldNamKl%,PSET
  462.   PUT (47+po%,95),FeldNamKl%,PSET
  463.   PUT (126+po%,95),FeldNamKl%,PSET         
  464.   PUT (56+po%,42),FeldnamGr%,PSET
  465.   PUT (106+po%,97),FeldnamGr%,PSET
  466.   CALL schreiben (po%,"K",farb%)
  467. END SUB 
  468.  
  469. SUB Dame (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC   
  470.   CALL karte (po%+40,2) 
  471.   PUT (47+po%,49),FeldNamKl%,PSET
  472.   PUT (126+po%,49),FeldNamKl%,PSET
  473.   PUT (47+po%,95),FeldNamKl%,PSET
  474.   PUT (126+po%,95),FeldNamKl%,PSET         
  475.   PUT (56+po%,42),FeldnamGr%,PSET
  476.   PUT (106+po%,97),FeldnamGr%,PSET
  477.   CALL schreiben (po%,"D",farb%)
  478. END SUB 
  479.  
  480. SUB Bube (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC
  481.   CALL karte (po%+40,2) 
  482.   PUT (47+po%,49),FeldNamKl%,PSET
  483.   PUT (126+po%,49),FeldNamKl%,PSET
  484.   PUT (47+po%,95),FeldNamKl%,PSET
  485.   PUT (126+po%,95),FeldNamKl%,PSET         
  486.   PUT (56+po%,42),FeldnamGr%,PSET
  487.   PUT (106+po%,97),FeldnamGr%,PSET
  488.   CALL schreiben (po%,"B",farb%)
  489. END SUB 
  490.  
  491. SUB Zehn (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC
  492.   CALL karte (po%+40,2) 
  493.   PUT (47+po%,49),FeldNamKl%,PSET
  494.   PUT (126+po%,49),FeldNamKl%,PSET
  495.   PUT (47+po%,95),FeldNamKl%,PSET
  496.   PUT (126+po%,95),FeldNamKl%,PSET         
  497.   FOR i=42 TO 97 STEP 18
  498.     PUT (58+po%,i),FeldnamGr%,PSET
  499.     PUT (104+po%,i),FeldnamGr%,PSET
  500.   NEXT i
  501.   PUT (81+po%,51),FeldnamGr%,PSET
  502.   PUT (81+po%,88),FeldnamGr%,PSET
  503.   CALL schreiben (po%,"10",farb%)
  504. END SUB 
  505.  
  506. SUB Neun (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC
  507.   CALL karte (po%+40,2) 
  508.   PUT (47+po%,49),FeldNamKl%,PSET
  509.   PUT (126+po%,49),FeldNamKl%,PSET
  510.   PUT (47+po%,95),FeldNamKl%,PSET
  511.   PUT (126+po%,95),FeldNamKl%,PSET         
  512.   FOR i=42 TO 97 STEP 18
  513.     PUT (58+po%,i),FeldnamGr%,PSET
  514.     PUT (104+po%,i),FeldnamGr%,PSET
  515.   NEXT i
  516.   PUT (81+po%,70),FeldnamGr%,PSET
  517.   CALL schreiben (po%,"9",farb%)
  518. END SUB 
  519.  
  520. SUB Acht (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC
  521.   CALL karte (po%+40,2) 
  522.   PUT (47+po%,49),FeldNamKl%,PSET
  523.   PUT (126+po%,49),FeldNamKl%,PSET
  524.   PUT (47+po%,95),FeldNamKl%,PSET
  525.   PUT (126+po%,95),FeldNamKl%,PSET         
  526.   FOR i=42 TO 97 STEP 27
  527.     PUT (58+po%,i),FeldnamGr%,PSET
  528.     PUT (104+po%,i),FeldnamGr%,PSET
  529.   NEXT i
  530.   PUT (81+po%,55),FeldnamGr%,PSET
  531.   PUT (81+po%,84),FeldnamGr%,PSET
  532.   CALL schreiben (po%,"8",farb%)
  533. END SUB 
  534.  
  535. SUB Sieben (po%,FeldNamKl%(),FeldnamGr%(),farb%) STATIC
  536.   CALL karte (po%+40,2) 
  537.   PUT (47+po%,49),FeldNamKl%,PSET
  538.   PUT (126+po%,49),FeldNamKl%,PSET
  539.   PUT (47+po%,95),FeldNamKl%,PSET
  540.   PUT (126+po%,95),FeldNamKl%,PSET         
  541.   FOR i=42 TO 97 STEP 27
  542.     PUT (58+po%,i),FeldnamGr%,PSET
  543.     PUT (104+po%,i),FeldnamGr%,PSET
  544.   NEXT i
  545.   PUT (81+po%,55),FeldnamGr%,PSET
  546.   CALL schreiben (po%,"7",farb%)
  547. END SUB 
  548.  
  549. SUB diskfont(font$,height%) STATIC
  550.  
  551.   SHARED strFont&
  552.   prefs%=96
  553.   font0$=font$+".font"+CHR$(0)
  554.   IF strFont&<>0 THEN CALL CloseFont(strFont&)
  555.   textAttr&(0)=SADD(font0$)
  556.   textAttr&(1)=height%*2^16+prefs%
  557.   strFont&=OpenDiskFont&(VARPTR(textAttr&(0)))
  558.   IF strFont&<>0 THEN CALL SetFont (WINDOW(8),strFont&)
  559.   
  560. END SUB
  561.   
  562. ' *********** Shadow-Print ***********
  563. '_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
  564.  
  565. SUB shadow(Text$,spacing%) STATIC
  566.  
  567.   depth%=2
  568.   crsX%=POS(0)
  569.   crsY%=(CSRLIN)*8            'Cursor-Koordinaten
  570.   IF crsY%<8 THEN crsY%=8     'erste BS-Zeile ins Format
  571.   CALL SetDrMd&(WINDOW(8),0)  'JAM1
  572.   FOR loop%=1 TO LEN(Text$)
  573.     b$=MID$(Text$,loop%,1)
  574.     e&=Move&(WINDOW(8),crsX%-depth%,crsY%+depth%)
  575.     COLOR 3,0                 'Schatten (schwarz) malen
  576.     PRINT b$
  577.     COLOR 4,0
  578.     e&=Move&(WINDOW(8),crsX%,crsY%)
  579.     PRINT b$                       'Zeichen malen
  580.     crsX%=crsX%+spacing%
  581.   NEXT loop%
  582.   PRINT 
  583.   CALL SetDrMd&(WINDOW(8),1)  'JAM2 (normal)
  584. END SUB
  585.  
  586. SUB tilt STATIC 
  587.   he&=PEEKL(WINDOW(7)+46)
  588.   rp&=he&+84
  589.   y%=255
  590.   FOR i%=0 TO 49
  591.     x%=16*i%
  592.     CALL ScrollRaster(rp&,0,i%-20,x%,0,x%+15,y%)
  593.   NEXT i%  
  594.   x%=639 : n%=INT(255/50)
  595.   FOR i%=0 TO 59
  596.     y%=i%*n%
  597.     CALL ScrollRaster(rp&,25-i%,0,0,y%,x%,y%+n%-1)
  598.   NEXT i%
  599.   FOR i=1 TO 2000:NEXT i
  600.   FOR i=1 TO 65  
  601.     CALL MoveScreen(he&,0,4)
  602.   NEXT i   
  603.   FOR i%=0 TO 59 
  604.     y%=i%*n%
  605.     CALL ScrollRaster(rp&,-25+i%,0,0,y%,x%,y%+n%-1)
  606.   NEXT i%
  607.   FOR i%=0 TO 49 
  608.     x%=16*i%
  609.     CALL ScrollRaster(rp&,0,-i%+20,x%,0,x%+15,y%)
  610.   NEXT i%  
  611.   FOR i=1 TO 65  
  612.     CALL MoveScreen(he&,0,-4)
  613.   NEXT i  
  614.   
  615. END SUB
  616.  
  617. '_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-
  618.  
  619. SUB shadow2(Text$,spacing%) STATIC
  620.  
  621.   depth%=2
  622.   crsX%=POS(0)
  623.   crsY%=(CSRLIN)*8            'Cursor-Koordinaten
  624.   IF crsY%<8 THEN crsY%=8     'erste BS-Zeile ins Format
  625.   CALL SetDrMd&(WINDOW(8),0)  'JAM1
  626.   FOR loop%=1 TO LEN(Text$)
  627.     b$=MID$(Text$,loop%,1)
  628.     e&=Move&(WINDOW(8),crsX%+depth%,crsY%+depth%)
  629.     COLOR 0,0                 'Schatten (schwarz) malen
  630.     PRINT b$
  631.     COLOR 4,0
  632.     e&=Move&(WINDOW(8),crsX%,crsY%)
  633.     PRINT b$                       'Zeichen malen
  634.     crsX%=crsX%+spacing%
  635.   NEXT loop%
  636.   PRINT 
  637.   CALL SetDrMd&(WINDOW(8),1)  'JAM2 (normal)
  638.   
  639.   END SUB
  640.     
  641.   
  642.